home *** CD-ROM | disk | FTP | other *** search
/ Technotools / Technotools (Chestnut CD-ROM)(1993).ISO / database / boxfunc / box_func.prg next >
Text File  |  1991-01-17  |  8KB  |  317 lines
  1. *********************************************
  2. * FUNCTIONS FOR BOXES FOR Clipper SUMMER '87
  3. * and Compatible with Clipper 5.0
  4. * ebox(), mbox(), pbox(), dbox()
  5. *
  6. * ALL box funtions return the string for restoring the screen
  7. * with RESTSCREEN().
  8. *
  9. * If you find these functions useful, please let me know.
  10. * A contribution of $5.00 would'nt hurt either.  ENJOY!!
  11. *
  12. *
  13. * by: DAVID TESSITORE
  14. *     15 Teed Street
  15. *     Huntington Station, NY  11746
  16. *********************************************
  17.  
  18. ***********************************************
  19. ****EXPLODING BOX***
  20. ****
  21. **** example: ebox(5,0,20,79,"GR+/R",30,1,.T.,"Dave's Menu","R/W")
  22. ****
  23. **********************************************
  24. FUNCTION ebox
  25. **********************************************
  26. PARAMETERS top,left,bottom,right,color,speed,boxtype,shadow,btitle,bcolor
  27. PRIVATE t,b,l,r,s,oldcolor,retscr,boxframe,seed1,seed2
  28. retscr=boxscr(top,left,bottom,right)
  29. oldcolor=SETCOLOR()
  30. boxframe=getbox(boxtype)
  31. seed1=INT((bottom-top)/2)
  32. seed2=INT((right-left)/2)
  33. t=top+seed1
  34. l=left+seed2
  35. b=t
  36. r=l
  37. SETCOLOR(color)
  38. SET CURSOR OFF
  39. DO WHILE ( t > top .AND. l > left) .AND. ( b < bottom .AND. r < right)
  40.    @ t, l, b, r BOX boxframe
  41.    t = t - 1
  42.    l = l - ( seed2 / seed1)
  43.    b = b + 1
  44.    r = r + ( seed2 / seed1)
  45.    FOR s= 1 TO speed
  46.    NEXT s
  47. ENDDO
  48. @ top,left,bottom,right BOX boxframe
  49. IF shadow 
  50.    boxshadow(top,left,bottom,right)
  51. ENDIF
  52. IF PCOUNT() > 8
  53.    SETCOLOR(bcolor)
  54.    lenscr=((right-left)/2)+left
  55.    @ top,lenscr - (LEN(btitle)/2) SAY btitle
  56. ENDIF
  57. SETCOLOR(oldcolor)
  58. SET CURSOR ON
  59. RETURN (retscr)
  60. ********************************************
  61. ** MIDDLE BOX
  62. ** example: mbox(5,0,20,79,"GR+/R",30,1,.T.,"Dave's Menu","R/W")
  63. **
  64. FUNCTION mbox
  65. *********************************************
  66. PARAMETERS top,left,bottom,right,color,speed,boxtype,shadow,btitle,bcolor
  67. PRIVATE t,b,l,r,s,oldcolor,retscr,boxframe
  68. retscr=boxscr(top,left,bottom,right)
  69. oldcolor=SETCOLOR()
  70. boxframe=getbox(boxtype)
  71. t=INT(top+(bottom-top)/2)
  72. b=t
  73. l=left
  74. r=right
  75. SETCOLOR(color)
  76. SET CURSOR OFF
  77. DO WHILE t > top .AND. b < bottom
  78.    FOR s= 1 TO speed
  79.    NEXT s
  80.    @ t,l,b,r BOX boxframe
  81.    t=t-1
  82.    b=b+1
  83. ENDDO
  84. @ top,left,bottom,right BOX boxframe
  85. IF shadow 
  86.    boxshadow(top,left,bottom,right)
  87. ENDIF
  88. IF PCOUNT() > 8
  89.    SETCOLOR(bcolor)
  90.    lenscr=((right-left)/2)+left
  91.    @ top,lenscr - (LEN(btitle)/2) SAY btitle
  92. ENDIF
  93. SETCOLOR(oldcolor)
  94. SET CURSOR ON
  95. RETURN (retscr)
  96. ********************************************
  97. ** POP BOX
  98. ** example: pbox(5,0,20,79,"GR+/R",30,1,.T.,"Dave's Menu","R/W")
  99. **
  100. FUNCTION pbox
  101. ********************************************
  102. PARAMETERS top,left,bottom,right,color,speed,boxtype,shadow,btitle,bcolor
  103. PRIVATE t,b,l,r,s,oldcolor,retscr,boxframe
  104. retscr=boxscr(top,left,bottom,right)
  105. oldcolor=SETCOLOR()
  106. boxframe=getbox(boxtype)
  107. t=bottom
  108. b=t
  109. l=left
  110. r=right
  111. SETCOLOR(color)
  112. SET CURSOR OFF
  113. DO WHILE t >= top
  114.    FOR s=1 TO speed
  115.    NEXT s
  116.    @ t,l,b,r BOX boxframe
  117.    t=t-1
  118. ENDDO
  119. IF shadow 
  120.    boxshadow(top,left,bottom,right)
  121. ENDIF
  122. IF PCOUNT() > 8
  123.    SETCOLOR(bcolor)
  124.    lenscr=((right-left)/2)+left
  125.    @ top,lenscr - (LEN(btitle)/2) SAY btitle
  126. ENDIF
  127. SETCOLOR(oldcolor)
  128. SET CURSOR ON
  129. RETURN (retscr)
  130. ********************************************
  131. ** DROP BOX
  132. ** example: dbox(5,0,20,79,"GR+/R",30,1,.T.,"Dave's Menu","R/W")
  133. **
  134. FUNCTION dbox
  135. ********************************************
  136. PARAMETERS top,left,bottom,right,color,speed,boxtype,shadow,btitle,bcolor
  137. PRIVATE t,l,b,r,s,oldcolor,retscr,boxframe
  138. retscr=boxscr(top,left,bottom,right)
  139. oldcolor=SETCOLOR()
  140. boxframe=getbox(boxtype)
  141. t=top
  142. b=t
  143. l=left
  144. r=right
  145. SETCOLOR(color)
  146. SET CURSOR OFF
  147. DO WHILE b <= bottom
  148.    FOR s= 1 TO speed
  149.    NEXT s
  150.    @ t,l,b,r BOX boxframe
  151.    b=b+1
  152. ENDDO
  153. IF shadow 
  154.    boxshadow(top,left,bottom,right)
  155. ENDIF
  156. IF PCOUNT() > 8
  157.    SETCOLOR(bcolor)
  158.    lenscr=((right-left)/2)+left
  159.    @ top,lenscr - (LEN(btitle)/2) SAY btitle
  160. ENDIF
  161. SETCOLOR(oldcolor)
  162. SET CURSOR ON
  163. RETURN (retscr)
  164.  
  165. **************************************
  166. ** BOX SHADOW- GREY ON BLACK
  167. ****
  168. FUNCTION BoxShadow
  169. **************************************
  170. PARAMETERS top,left,bottom,right
  171. PRIVATE stop,sleft,sbottom,sright
  172.  
  173. GREY_ON_BLACK="X"+CHR(8)
  174. stop=bottom+1
  175. sbottom=stop
  176. sleft=left+1
  177. sright=right+1
  178.  
  179. DO CASE
  180.    CASE bottom < 24 .AND. right < 79 
  181.         RESTSCREEN( sbottom, sleft,sbottom,sright,;
  182.         TRANSFORM( SAVESCREEN(stop, sleft, sbottom, sright),;
  183.         REPLICATE(GREY_ON_BLACK, sright - sleft + 1 ) ) )
  184.         stop   = top + 1
  185.         sleft  = right + 1
  186.         sright = sleft
  187.         sbottom= bottom +1
  188.         RESTSCREEN( stop, sleft,sbottom,sright,;
  189.         TRANSFORM( SAVESCREEN(stop, sleft, sbottom, sright),;
  190.         REPLICATE(GREY_ON_BLACK, sbottom - stop + 1 ) ) )
  191.    CASE bottom = 24 .AND. right < 79
  192.         stop   = top + 1
  193.         sleft  = right + 1
  194.         sright = sleft
  195.         sbottom = bottom
  196.         RESTSCREEN( stop, sleft,sbottom,sright,;
  197.         TRANSFORM( SAVESCREEN(stop, sleft, sbottom, sright),;
  198.         REPLICATE(GREY_ON_BLACK, sbottom - stop + 1) ) )
  199.       CASE bottom < 24 .AND. right = 79
  200.         sright=right
  201.         RESTSCREEN( sbottom, sleft,sbottom,sright,;
  202.         TRANSFORM( SAVESCREEN(stop, sleft, sbottom, sright),;
  203.         REPLICATE(GREY_ON_BLACK, sright - sleft + 1 ) ) )
  204.    ENDCASE
  205. RETURN (.T.)
  206.  
  207. ***************
  208. FUNCTION boxscr
  209. ***************
  210. PARAMETERS top,left,bottom,right
  211. PRIVATE retval
  212. DO CASE
  213.    CASE bottom < 24 .AND. right < 79 
  214.         retval=SAVESCREEN(top, left, bottom+1, right+1)
  215.    CASE bottom = 24 .AND. right < 79
  216.         retval=SAVESCREEN(top, left, bottom, right+1)
  217.    CASE bottom < 24 .AND. right = 79
  218.         retval=SAVESCREEN(top, left, bottom+1, right)
  219.    CASE bottom = 24 .AND. right = 79
  220.         retval=SAVESCREEN(top, left, bottom, right)
  221. ENDCASE
  222. RETURN (retval)
  223.  
  224.  
  225. **************************************
  226. FUNCTION getbox
  227. *****************************************
  228. *    Example:
  229. *    scrframe=getbox(1)
  230. ****************************************
  231. PARAMETERS btype
  232.  
  233. ****< BOXES DEFINED > ****
  234.  
  235. **< Single-line box >**
  236. * ┌───┐
  237. * │   │
  238. * └───┘
  239. B_SINGLE=( CHR(218) + CHR(196) + CHR(191) + CHR(179) + ;  
  240.     CHR(217) + CHR(196) + CHR(192) + CHR(179) + " ")
  241.  
  242. **< Double-line box >**
  243. * ╔═══╗ 
  244. * ║   ║
  245. * ╚═══╝
  246. B_DOUBLE=( CHR(201) + CHR(205) + CHR(187) + CHR(186) + ;
  247.     CHR(188) + CHR(205) + CHR(200) + CHR(186) + " ")
  248.  
  249. **< Single-line top, double-line sides >**
  250. * ╓───╖
  251. * ║   ║
  252. * ╙───╜
  253. B_SINGLE_DOUBLE=( CHR(214) + CHR(196) + CHR(183) + CHR(186) + ;
  254.         CHR(189) + CHR(196) + CHR(211) + CHR(186) + " ")
  255.  
  256. **< Double-line top, single-line sides >**
  257. * ╒═══╕
  258. * │   │
  259. * ╘═══╛
  260. B_DOUBLE_SINGLE=( CHR(213) + CHR(205) + CHR(184) + CHR(179) + ;
  261.         CHR(190) + CHR(205) + CHR(212) + CHR(179) + " ")
  262.  
  263. **< Thick box border all around >**
  264. * █████
  265. * █   █
  266. * █████
  267. B_THICK=(REPLICATE(CHR(219),8)+" ")
  268.  
  269. **< Single-top and left, double-bottom and right-side >**
  270. * ┌───╖
  271. * │   ║
  272. * ╘═══╝ 
  273. B_SINGLE_DOUBLE_B=( CHR(218) + CHR(196) + CHR(183) + CHR(186) + ;  
  274.     CHR(188) + CHR(205) + CHR(212) + CHR(179) + " ")
  275.  
  276. **< Double-top and left-side, single-bottom and right
  277. * ╔═══╕
  278. * ║   │
  279. * ╙───┘
  280. B_DOUBLE_SINGLE_B=( CHR(201) + CHR(205) + CHR(184) + CHR(179) + ;
  281.     CHR(217) + CHR(196) + CHR(211) + CHR(186) + " ")
  282.  
  283. **< Music symbol >**
  284. B_MUSIC=(REPLICATE(CHR(14),8)+" ")
  285.  
  286. **< Heart symbol >**
  287. B_HEART=(REPLICATE(CHR(3),8)+" ")
  288.  
  289. **< Diamond symbol >**
  290. B_DIAMOND=(REPLICATE(CHR(4),8)+" ")
  291.  
  292. ************************
  293. DO CASE
  294.    CASE btype=1
  295.         RETURN(B_SINGLE)
  296.    CASE btype=2
  297.     RETURN(B_DOUBLE) 
  298.    CASE btype=3
  299.         RETURN(B_SINGLE_DOUBLE)
  300.    CASE btype=4
  301.         RETURN(B_DOUBLE_SINGLE)
  302.    CASE btype=5
  303.         RETURN(B_THICK)
  304.    CASE btype=6
  305.         RETURN(B_SINGLE_DOUBLE_B)
  306.    CASE btype=7
  307.         RETURN(B_DOUBLE_SINGLE_B)
  308.    CASE btype=8
  309.         RETURN(B_MUSIC)
  310.    CASE btype=9
  311.         RETURN(B_HEART)
  312.    CASE btype=10
  313.         RETURN(B_DIAMOND)
  314. ENDCASE
  315.  
  316.  
  317.